home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / Libraries / SAT 2.3b4 / Demo ƒ / StepZkrolly demo ƒ / StepZkrolly.p < prev    next >
Encoding:
Text File  |  1995-01-17  |  3.4 KB  |  126 lines  |  [TEXT/PJMM]
  1. {This is a quick hack on Zkrolly to tweak it into a step-scrolling demo instead.}
  2. {A case that I find much more realistic is to use a fairly large offscreen, perhaps the size of a 17" screen,}
  3. {and use the full screen on smaller screens, with step-scrolls as necessary. I might make something like it}
  4. {later, but this at least shows the principle.}
  5.  
  6. program StepZkrolly;
  7.     uses
  8. {$ifc UNDEFINED THINK_PASCAL}
  9.         Types, QuickDraw, Fonts, Windows, Dialogs, OSUtils, Memory, {}
  10. {$endc}
  11.         SAT, sXprite, sZprite;
  12.  
  13.     var
  14.         ignoresp, zp: SpritePtr;
  15.         zWind: WindowPtr;
  16.         r: Rect;
  17.  
  18.     const
  19.         scrollsizeH = 250;
  20.         scrollsizeV = 200;
  21.  
  22.     var
  23.         nowOff: Point;
  24.  
  25.     procedure Zteppy;
  26.         var
  27.             where: Point;
  28.             srcRect: Rect;
  29. {max och min borde vara inline!}
  30.         function max (a, b: integer): integer;
  31.         begin
  32.             if a > b then
  33.                 max := a
  34.             else
  35.                 max := b;
  36.         end;
  37.         function min (a, b: integer): integer;
  38.         begin
  39.             if a < b then
  40.                 min := a
  41.             else
  42.                 min := b;
  43.         end;
  44.  
  45.     begin
  46.         where := zp^.position;
  47.         where.h := where.h - BSR(scrollsizeH, 2);
  48.         where.v := where.v - BSR(scrollsizeV, 2);
  49.         if where.h < 0 then
  50.             where.h := 0;
  51.         if where.v < 0 then
  52.             where.v := 0;
  53.         if where.h + scrollsizeH > gSAT.offSizeH then
  54.             where.h := gSAT.offSizeH - scrollsizeH;
  55.         if where.v + scrollsizeV > gSAT.offSizeV then
  56.             where.v := gSAT.offSizeV - scrollsizeV;
  57.  
  58.         if (abs(where.h - nowOff.h) > scrollsizeH div 3) or (abs(where.v - nowOff.v) > scrollsizeV div 3) then
  59.             repeat
  60.                 begin
  61. {nowOff := where;}
  62.                     if nowOff.h > where.h then
  63.                         nowOff.h := max(nowOff.h - 5, where.h);
  64.                     if nowOff.h < where.h then
  65.                         nowOff.h := min(nowOff.h + 5, where.h);
  66.                     if nowOff.v > where.v then
  67.                         nowOff.v := max(nowOff.v - 5, where.v);
  68.                     if nowOff.v < where.v then
  69.                         nowOff.v := min(nowOff.v + 5, where.v);
  70.  
  71.                     SATSetPortScreen;
  72.                     SetOrigin(nowOff.h, nowOff.v);
  73.  
  74.                     srcRect := gSAT.wind.port^.portRect;
  75.  
  76.                     CopyBits(gSAT.offScreen.port^.portBits, gSAT.wind.port^.portBits, srcRect, srcRect, srcCopy, nil);
  77. {SATCopyBitsToScreen(gSAT.offScreen, srcRect, srcRect, false);}
  78.                 end
  79.             until longint(nowOff) = longint(where);
  80.     end;
  81.  
  82.     procedure SetupZwind;
  83.         var
  84.             zr: Rect;
  85.             wrld: SysEnvRec;
  86.     begin
  87. {Since SAT hasn't been initialized, we can't use gSAT.colorFlag but have to check environs ourselves.}
  88.         if noErr <> SysEnvirons(1, wrld) then
  89.             ; {ignore errors}
  90.         SetRect(zr, 20, 30, 20 + scrollSizeH, 30 + scrollSizeV);
  91.         if wrld.hasColorQD then
  92.             Zwind := NewCWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0)
  93.         else
  94.             Zwind := NewWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0);
  95.     end;
  96.  
  97. begin
  98. {In case this isn't Think Pascal we have to make the standard inits ourselves.}
  99. {$IFC UNDEFINED THINK_PASCAL}
  100.     SATInitToolbox;
  101. {$ENDC}
  102.  
  103.     SetupZwind;
  104.  
  105.     SetRect(r, 0, 0, 510, 340);
  106.     SATCustomInit(128, 129, r, zwind, nil, false, false, false, true, false);
  107.     InitXprite;
  108.     InitZprite;
  109.     ShowWindow(gSAT.wind.port);
  110.     SelectWindow(gSAT.wind.port);
  111.     zp := SATNewSprite(0, 90, 70, @SetupZprite);
  112.     ignoresp := SATNewSprite(0, 120, 100, @SetupXprite);
  113.     ignoresp := SATNewSprite(0, 200, 160, @SetupXprite);
  114.     SATSoundOff;
  115.     SATRedraw;
  116.     SATSetPortScreen;
  117.     repeat
  118.         SATRun(false);
  119.         Zteppy;
  120.     until Button;
  121.  
  122. {WARNING! It seems like we mess up the current device somewhere. Probably a bug in SAT}
  123. {(where the device setting isn't perfect yet). Let's set port and device to something nice and safe!}
  124.     SATSetPortScreen;
  125.     SATSoundShutup;
  126. end.